home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / ioState.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  8.4 KB  |  260 lines  |  [TEXT/3PRM]
  1. implementation module ioState;
  2.  
  3. import StdClass;
  4. import    StdInt, StdBool, StdMisc, StdString;
  5. import    events, menus, windows, controls, pointer, desk;
  6. import    timerDef, menuDef, windowDef, dialogDef, event;
  7. from    deltaIOSystem    import    DeviceSystem, TimerSystem, MenuSystem,
  8.                                 WindowSystem, DialogSystem;
  9. from    deltaPicture    import    Point;
  10.  
  11. EmptyMacMenuHandle :== 0;
  12.  
  13. ::    *IOState *s
  14.     :==    (    ![DeviceSystemState s],
  15.             !EVENTS,
  16.             !ButtonFreqState,
  17.             !Toolbox    );
  18.  
  19. ::    DeviceSystemState    *s    =    TimerSystemState    (TimerHandles    s)
  20.                             |    MenuSystemState        (MenuHandles    s)
  21.                             |    WindowSystemState    (WindowHandles    s)
  22.                             |    DialogSystemState    (DialogHandles    s);
  23.  
  24. ::    TimerHandles        *s    :==    [TimerHandle s];
  25. ::    TimerHandle            *s    :==    (!TimerDef s (IOState s), !Time);
  26. ::    Time                    :==    Int;
  27.                         
  28.  
  29. ::    MenuHandles            *s    :==    (![MenuHandle s], ![Char], !MacMenuHandle, !Bool);
  30. ::    MenuHandle            *s
  31.     =     PullDownHandle        MacMenuHandle MenuId MenuId SelectState [MenuHandle s]
  32.     |     MenuItemHandle        MenuItemId Char (MenuFunction s (IOState s))
  33.     |     CheckMenuItemHandle    MenuItemId Char (MenuFunction s (IOState s))
  34.     |     SubMenuItemHandle    MacMenuHandle MenuId MenuId    [MenuHandle s]
  35.     |     MenuItemGroupHandle    MenuItemGroupId                [MenuHandle s]
  36.     |     MenuRadioItemsHandle                            [MenuHandle s]
  37.     |     MenuSeparatorHandle;
  38.  
  39.  
  40. ::    WindowHandles        *s    :==    (![WindowHandle s], !GlobalCursor);
  41. ::    WindowHandle        *s    :==    (!WindowDef s (IOState s), !Window);
  42. ::    Window
  43.     :==    (    !WindowPtr,
  44.             !ScrollState,
  45.             !ScrollState,
  46.             !Int,
  47.             !UpdateArea,
  48.             !ZoomState    );
  49. ::    ScrollState
  50.     :==    (    !ControlHandle,
  51.             !Int,
  52.             !Int        );
  53. ::    ZoomState
  54.     :==    (    !Int,
  55.             !Int        );
  56. ::    GlobalCursor
  57.     =    GlobalCursorSet CursorShape
  58.     |    NoGlobalCursor;
  59. ::    DoubleDownDist
  60.     :==    Int;
  61.  
  62. ::    DialogHandles        *s    :==    [DialogRep s (IOState s)];
  63.  
  64.  
  65. ::    Device
  66.     =    TimerDevice | MenuDevice | WindowDevice | DialogDevice;
  67.  
  68. ::    DeviceFunctions        *s
  69.     :==    (    !ShowFunction    s,
  70.             !OpenFunction    s,
  71.             !DoIOFunction    s,
  72.             !CloseFunction    s,
  73.             !HideFunction    s    );
  74.  
  75. ::    ShowFunction  *s :== !(IOState s) -> !IOState s;
  76. ::    OpenFunction  *s :== !(DeviceSystem s (IOState s)) -> (!(IOState s) -> IOState s);
  77. ::    DoIOFunction  *s :== !Event -> (!s -> *(!(IOState s) -> (!Bool, !s, !IOState s)));
  78. ::    CloseFunction *s :== !(IOState s) -> IOState s;
  79. ::    HideFunction  *s :== !(IOState s) -> IOState s;
  80.  
  81.  
  82. ::    ButtonFreqState    :== (!Time, !ButtonFreq, !DoubleDownDist, !Point, !WindowPtr);
  83. ::    ButtonFreq        :== Int;
  84.  
  85.  
  86. DoubleTime    :== 752;    // the address containing the LongInt of the DoubleTime.
  87.  
  88.  
  89. IOStateError :: String String -> .x;
  90. IOStateError f error = Error f "ioState" error;
  91.  
  92.  
  93. //    Creation rules for IOStates:
  94.  
  95. NewIOStateFromOld :: !(IOState s) -> (!IOState t, !IOState s);
  96. NewIOStateFromOld (ds, es, bfs, tb) = (EmptyIOState es, (ds, EmptyEVENTS, bfs, tb));
  97.  
  98. OldIOStateFromNew :: !(IOState s) !(IOState t) -> IOState s;
  99. OldIOStateFromNew (ds, e, bfs, tb) (_, es, _, _) 
  100.     | IsEmptyEVENTS e = (ds, es, bfs, tb);
  101.  
  102. EmptyIOState :: !EVENTS -> IOState s;
  103. EmptyIOState es = ([], es, InitButtonFreqState, NewToolbox);
  104.  
  105. IOStateEvents :: !(IOState s) -> EVENTS;
  106. IOStateEvents (ds, es, bfs, tb) = es;
  107.  
  108.  
  109.     InitButtonFreqState    :==    (0, 0, 5, (0,0), 0);
  110. //    InitButtonFreqState    =    (time, nr_down, double down dist, point, window);
  111.  
  112.  
  113. //    Access rules on IOStates:
  114.  
  115. IOStateButtonFreq :: !Time !Point !WindowPtr !(IOState s) -> (!ButtonState, !IOState s);
  116. IOStateButtonFreq time pos cur_w (ds, es, bfs=:(dtime, down, dist, old_pos, old_w), tb)
  117. |    cur_w    <>    old_w    = (ButtonDown,          (ds, es, (time, 1, dist, pos, cur_w), tb));
  118. |    dt        >    dTime
  119. ||    dist`    >    dist    = (ButtonDown,          (ds, es, (time, 1, dist, pos, cur_w), tb1));
  120. |    down    ==    1        = (ButtonDoubleDown,  (ds, es, (time, 2, dist, pos, cur_w), tb1));
  121.                         = (ButtonTripleDown,  (ds, es, (time, 0, dist, pos, cur_w), tb1));
  122.     where {
  123.         (dTime,tb1)    = LoadLong DoubleTime tb;    
  124.         dist`        = Dist x x` + Dist y y`;
  125.         (x`,y`)        = pos;
  126.         (x ,y )        = old_pos;
  127.         dt            = time - dtime;
  128.     };
  129.  
  130. IOStateSetDoubleDownDist :: !DoubleDownDist !(IOState s) -> IOState s;
  131. IOStateSetDoubleDownDist d ioState=:(ds, es, (dtime, down, d`, pos, wPtr), tb)
  132. |    d == d`    = ioState;
  133.             = (ds, es, (dtime, down, Max 0 d, pos, wPtr), tb);
  134.  
  135.  
  136. IOStateClosed :: !(IOState s) -> (!Bool, !IOState s);
  137. IOStateClosed ioState=:([],_,_,_)    = (True, ioState);
  138. IOStateClosed ioState                = (False, ioState);
  139.  
  140. IOStateHasDevice :: !(IOState s) !Device -> (!Bool, !IOState s);
  141. IOStateHasDevice ioState=:(ds,_,_,_) d = (DevicesHaveDevice ds d, ioState);
  142.  
  143. DevicesHaveDevice :: ![DeviceSystemState s] !Device -> Bool;
  144. DevicesHaveDevice [dState : ds] device
  145. |    EqualDevice (DeviceSystemStateToDevice dState) device    = True;
  146.                                                             = DevicesHaveDevice ds device;
  147. DevicesHaveDevice _ _                                        = False;
  148.  
  149. IOStateGetAnyDevice :: !(IOState s) -> (!DeviceSystemState s, !IOState s);
  150. IOStateGetAnyDevice ioState=:([dState : _],_,_,_) = (dState, ioState);
  151. IOStateGetAnyDevice _
  152.     = IOStateError "IOStateGetAnyDevice" "ioState" "IOState argument is empty";
  153.  
  154. IOStateGetDevice :: !(IOState s) !Device -> (!DeviceSystemState s, !IOState s);
  155. IOStateGetDevice ([],_,_,_) _
  156.     = IOStateError "IOStateGetDevice" "IOState argument is empty";
  157. IOStateGetDevice ioState=:(ds,_,_,_) d = (DevicesGetDevice ds d, ioState);
  158.  
  159. DevicesGetDevice :: ![DeviceSystemState s] !Device -> DeviceSystemState s;
  160. DevicesGetDevice [dState : ds] d
  161. |    EqualDevice (DeviceSystemStateToDevice dState) d    = dState;
  162.                                                         = DevicesGetDevice ds d;
  163. DevicesGetDevice _ d
  164.     =    IOStateError "IOStateGetDevice" (DeviceToString d +++ " not present in IOState");
  165.  
  166. IOStateRemoveAnyDevice :: !(IOState s) -> (!DeviceSystemState s, !IOState s);
  167. IOStateRemoveAnyDevice ([d : ds], es, bfs, tb) = (d, (ds, es, bfs, tb));
  168. IOStateRemoveAnyDevice _
  169.     =    IOStateError "IOStateRemoveAnyDevice" "IOState argument is empty";
  170.  
  171. IOStateRemoveDevice    :: !(IOState s) !Device -> IOState s;
  172. IOStateRemoveDevice (ds, es, bfs, tb) d = (DevicesRemoveDevice ds d, es, bfs, tb);
  173.  
  174. DevicesRemoveDevice    :: ![DeviceSystemState s] !Device -> [DeviceSystemState s];
  175. DevicesRemoveDevice [dState : ds] d
  176. |    EqualDevice (DeviceSystemStateToDevice dState) d    = ds;
  177.                                                         = let! {
  178.                                                             ds`
  179.                                                         } in [dState : ds`];
  180.     where {
  181.         ds` = DevicesRemoveDevice ds d;
  182.     };
  183. DevicesRemoveDevice ds _ = ds;
  184.  
  185. IOStateSetDevice :: !(IOState s) !(DeviceSystemState s) -> IOState s;
  186. IOStateSetDevice (ds, es, bfs, tb) d
  187.     =    let! {
  188.             ds`
  189.         } in (ds`, es, bfs, tb);
  190.     where {
  191.         ds` = DevicesSetDevice ds (Priority (DeviceSystemStateToDevice d)) d;
  192.     };
  193.  
  194. DevicesSetDevice :: ![DeviceSystemState s] !Int !(DeviceSystemState s) -> [DeviceSystemState s];
  195. DevicesSetDevice ds=:[dState1 : dStates] p dState2
  196. |    EqualDevice device1 (DeviceSystemStateToDevice dState2)    = [dState2 : dStates];
  197. |    p > Priority device1                                     = [dState2 : ds];
  198.                                                             = let! {
  199.                                                                 dStates1;
  200.                                                             } in  [dState1 : dStates1];
  201.     where {
  202.         device1  = DeviceSystemStateToDevice dState1;
  203.         dStates1 = DevicesSetDevice dStates p dState2;
  204.     };
  205. DevicesSetDevice _ _ dState = [dState];
  206.  
  207.  
  208. IOStateGetToolbox :: !(IOState s) -> (!Toolbox, !IOState s);
  209. IOStateGetToolbox (ds, es, bfs, tb) = (tb, (ds, es, bfs, NewToolbox));
  210.  
  211. IOStateSetToolbox :: !Toolbox !(IOState s) -> IOState s;
  212. IOStateSetToolbox tb (ds, es, bfs, _) = (ds, es, bfs, tb);
  213.  
  214. IOStateChangeToolbox :: !(!Toolbox -> !Toolbox) !(IOState s) -> IOState s;
  215. IOStateChangeToolbox f (ds, es, bfs, tb)
  216.     =    let! {
  217.             tb`;
  218.     } in (ds, es, bfs, tb`);
  219.     where {
  220.         tb` = f tb;
  221.     };
  222.  
  223. IOStateAccessToolbox :: !(!Toolbox -> !(!x, !Toolbox)) !(IOState s) -> (!x, !IOState s);
  224. IOStateAccessToolbox f (ds, es, bfs, tb)
  225. =     (x, (ds, es, bfs, tb1));
  226.     where {
  227.         (x, tb1) = f tb;
  228.     };
  229.  
  230.  
  231. //    Access-rules on DeviceSystemStates:
  232.  
  233. DeviceSystemStateToDevice :: !(DeviceSystemState s) -> Device;
  234. DeviceSystemStateToDevice (TimerSystemState     _) = TimerDevice;
  235. DeviceSystemStateToDevice (MenuSystemState     _) = MenuDevice;
  236. DeviceSystemStateToDevice (WindowSystemState _) = WindowDevice;
  237. DeviceSystemStateToDevice (DialogSystemState _) = DialogDevice;
  238.  
  239.  
  240. //    Operations on Devices:
  241.  
  242. EqualDevice    :: !Device        !Device            -> Bool;
  243. EqualDevice TimerDevice        TimerDevice        = True;
  244. EqualDevice MenuDevice         MenuDevice        = True;
  245. EqualDevice WindowDevice    WindowDevice    = True;
  246. EqualDevice DialogDevice    DialogDevice    = True;
  247. EqualDevice _                _                = False; 
  248.  
  249. DeviceToString :: !Device        -> String;
  250. DeviceToString TimerDevice        = "TimerDevice";
  251. DeviceToString MenuDevice        = "MenuDevice";
  252. DeviceToString WindowDevice        = "WindowDevice";
  253. DeviceToString DialogDevice        = "DialogDevice";
  254.  
  255. Priority :: !Device -> Int;
  256. Priority TimerDevice    = 4;
  257. Priority MenuDevice        = 3;
  258. Priority DialogDevice    = 2;
  259. Priority WindowDevice    = 1;
  260.